VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ESRIParser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'*************************************************************************
'  This source code is provided "as is" and as an unsupported sample of
'  a Microsoft Visual Basic application that incorporates the MapPoint 2002
'  object model and ActiveX control. It can only  be used in accordance with
'  the terms and conditions of the Microsoft MapPoint 2002 and
'  Microsoft Visual Basic End User License Agreements.
'*************************************************************************

'Refer to the "ESRI Shapefile Technical Description" document, located at
'www.esri.com, for detailed information on the Shapefile file format.

Private Const SHAPE_FILE_CODE As Long = 9994
Private Const MAIN_HEADER_SIZE As Long = 100
Private Const INDEX_REC_SIZE As Long = 8

Public Enum ESRI_SHAPETYPE
    SHAPETYPE_NULL = 0
    SHAPETYPE_POINT = 1
    SHAPETYPE_POLYLINE = 3
    SHAPETYPE_POLYGON = 5
    SHAPETYPE_MULTIPOINT = 8
    SHAPETYPE_POINT_Z = 11
    SHAPETYPE_POLYLINE_Z = 13
    SHAPETYPE_POLYGON_Z = 15
    SHAPETYPE_MULTIPOINT_Z = 18
    SHAPETYPE_POINT_M = 23
    SHAPETYPE_POLYLINE_M = 23
    SHAPETYPE_POLYGON_M = 25
    SHAPETYPE_MULTIPOINT_M = 28
    SHAPETYPE_MULTIPATCH = 31
End Enum

Private Type Type_BoundingBox
    fXMin As Double              'little
    fYMin As Double              'little
    fXMax As Double              'little
    fYMax As Double              'little
End Type

Private Type Type_FileHeader
    FileCode As Long             'big
    Unused1 As Long              'big
    Unused2 As Long              'big
    Unused3 As Long              'big
    Unused4 As Long              'big
    Unused5 As Long              'big
    FileLength As Long           'big
    Version As Long              'little
    ShapeType As Long            'little
    BoundingBoxXMin As Double    'little
    BoundingBoxYMin As Double    'little
    BoundingBoxXMax As Double    'little
    BoundingBoxYMax As Double    'little
    BoundingBoxZmin As Double    'little
    BoundingBoxZmax As Double    'little
    BoundingBoxMmin As Double    'little
    BoundingBoxMmax As Double    'little
End Type

Private Type Type_SHP_RecordHeader
    RecordNumber As Long         'big
    ContentLength As Long        'big
End Type

Private Type Type_SHX_RecordHeader
    Offset As Long               'big
    ContentLength As Long        'big
End Type

Private Type Type_LongType
    l As Long
End Type

Private Type Type_FourByteType
    b1 As Byte
    b2 As Byte
    b3 As Byte
    b4 As Byte
End Type

Private m_lSHPFileHandle As Long
Private m_lSHXFileHandle As Long
Private m_uSHPFileHeader As Type_FileHeader
Private m_uSHXFileHeader As Type_FileHeader
Private m_uSHPRecordHeader As Type_SHP_RecordHeader
Private m_uSHXRecordHeader As Type_SHX_RecordHeader
Private m_lRecordCount As Long
Private m_eShapeType As ESRI_SHAPETYPE

Public Function GenerateShapes(ByVal sFilename As String) As Object
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Reads the given ESRI Shapefile and generates a collection of either
    '           DataPoint, Line, or Region objects.
    ' Assumptions:
    ' Notes:
'**********************************************************************************

    Dim bSuccess As Boolean
    Dim oGeneratedShapes As Object

    On Error GoTo errorHandler
    
    'Try to open the .shp file.
    bSuccess = OpenShapeFile(sFilename)
    
    'If we succeeded, then determine the course of action depending on which
    'type of shapes are within the file.
    If bSuccess = True Then
        Select Case m_eShapeType
            Case SHAPETYPE_POINT
                'This is a Point file -- get the Point data.
                UpdateStatus "Points Found -- Getting PushPin Data"
                Set oGeneratedShapes = GeneratePoints()
            
            Case SHAPETYPE_MULTIPOINT
                'This is a MultiPoint file -- get the Point data.
                UpdateStatus "MultiPoints Found -- Getting PushPin Data"
                Set oGeneratedShapes = GeneratePoints()
                    
            Case SHAPETYPE_POLYLINE
                'This is a Line file -- get the line data.
                UpdateStatus "Lines Found -- Getting Shape Data"
                Set oGeneratedShapes = GenerateLines()
            
            Case SHAPETYPE_POLYGON
                'This is a Region file -- get the Region data.
                UpdateStatus "Regions Found -- Getting Shape Data"
                Set oGeneratedShapes = GenerateRegions()
                    
            Case Else
        End Select
        
        'Release our file handles.
        Close m_lSHPFileHandle
        Close m_lSHXFileHandle
        
    End If
    
    'Apply shape properties, such as names, which are defined in a ESRI .dbf file.
    If Not oGeneratedShapes Is Nothing Then
        UpdateStatus "Setting Shape Properties..."
        ApplyShapeProperties sFilename, oGeneratedShapes
    End If
    
    'Return the collection object.
    Set GenerateShapes = oGeneratedShapes
    
    Exit Function
errorHandler:
    MsgBox "Error in GenerateShapes" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Function

Private Function ApplyShapeProperties(ByVal sSHPFilename As String, _
                                      ByRef oGeneratedShapes As Object)
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Reads the ESRI .dbf file, which contains shape properties
    '           such as shape names, and applies these properties to the appropriate
    '           objects in our object model.
    ' Assumptions:
    ' Notes: Below is a sample record from the .dbf file:
    '
    '           "Washington Park",1,"CHIC"
    '
'**********************************************************************************

    Dim sSHPExtension As String
    Dim sDBFFilename As String
    Dim sShapeName As String
    Dim lShapeNumber As Long
    Dim dbDBASEDataStore As ADODB.Connection
    Dim rsRecords As ADODB.Recordset
    Dim sSqlStatement As String
    Dim lNumberOfRows As Integer
    Dim sConnectionString As String
    Dim sFilename As String
    Dim sPath As String
    Dim sShortFilename As String
    Dim lShapeCount As Long
    Dim vFieldValue As Variant
    Dim oField As ADODB.Field
    Dim oNameField As ADODB.Field
    
    Const DB_PROVIDER As String = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source="

    On Error GoTo errorHandler
    
    'Break the filename into Filename and Extension.
    ParseFileNameAndExtension sSHPFilename, sFilename, sSHPExtension
    
    'Get the filename with the .DBF extension.
    sDBFFilename = sFilename & ".dbf"
    
    'Make sure the .DBF file exists.  If not, then display a warning message.
    If Len(Dir(sDBFFilename)) <> 0 Then
    
        'Get the "short" (8.3) filename.  This is necessary because the SQL statement that is
        'used to open the .dbf file only works with 8.3 filenames.
        sShortFilename = GetShortFilename(sDBFFilename)
        
        'Break the path/filename into separate components.
        ParseFileAndPathName sShortFilename, sPath, sFilename
        
        'Define the connection string with just the path.
        sConnectionString = DB_PROVIDER & sPath & ";Extended Properties=dBASE 5.0;"
        
        'Define the SQL statement.  When dealing with dBASE files, the "table name" is the actual
        '.dbf filename.
        sSqlStatement = "SELECT * from [" & sFilename & "];"
        
        'Open the database connection.
        Set dbDBASEDataStore = New ADODB.Connection
        dbDBASEDataStore.Open sConnectionString
    
        'Create a new recordset.
        Set rsRecords = New ADODB.Recordset
        With rsRecords
        
            'We won't be updating any records, so we only need a static cursor and read-only locks.
            .CursorType = adOpenStatic
            .LockType = adLockReadOnly
    
            'Open the recordset.
            .Open sSqlStatement, dbDBASEDataStore
    
            'Make sure we got at least 1 record.
            If .BOF = True And .EOF = True Then
                'no records that match the criteria
            Else
                'Get the record count.
                .MoveLast
                .MoveFirst
                lNumberOfRows = .RecordCount
            
                If lNumberOfRows = oGeneratedShapes.Count Then
                
                    'Determine if there is a "name" field
                    For Each oField In .Fields
                        If UCase$(oField.Name) = "NAME" Then
                            Set oNameField = oField
                            Exit For
                        End If
                    Next oField
                    
                    'Didn't find a "name" field, so we'll just use the
                    'first field.
                    If oNameField Is Nothing Then
                        If .Fields.Count <> 0 Then
                            Set oNameField = .Fields(0)
                        End If
                    End If
                    
                    lShapeNumber = 1
                    
                    'Loop through all the records in the recordset.
                    Do Until .EOF
            
                        'Get the shape name by a "Name" field if it exists,
                        'Otherwise name it by the value of the first field.
                        If Not oNameField Is Nothing Then
                            vFieldValue = oNameField.Value
                            If Not IsNull(vFieldValue) Then
                                sShapeName = vFieldValue
                            End If
                        End If
                        
                        'If we didn't find a shape name for some reason, then we'll invent one.
                        If Len(sShapeName) = 0 Then
                            sShapeName = "Shape_" & lShapeNumber
                        End If
                        
                        'Assign the shape name.
                        oGeneratedShapes.Item(lShapeNumber).Name = sShapeName
                        frmSpatialDataImport.lblRecordCount.Caption = "Record Count: " & lShapeNumber
                        lShapeNumber = lShapeNumber + 1
                        .MoveNext
                    Loop
                End If
            End If
        End With
        
        'Clean up the database objects.
        rsRecords.Close
        Set rsRecords = Nothing
        dbDBASEDataStore.Close
        Set dbDBASEDataStore = Nothing
        
    Else
        MsgBox "The following file was not found:" & vbCrLf & vbCrLf _
             & sDBFFilename & vbCrLf & vbCrLf _
             & "Processing will continue, but no shape names will be applied."
    End If
    
    Exit Function
errorHandler:
    MsgBox "Error in ApplyShapeProperties" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
    Resume
End Function

Private Function OpenShapeFile(sSHPFilename As String) As Boolean
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Attempts to open the indicated .shp file and its associated .shx
    '           file, and reads the header data from each.
    ' Assumptions:
    ' Notes:
'**********************************************************************************

    Dim sFilename As String
    Dim sSHPExtension As String
    Dim sSHXFilename As String
    
    On Error GoTo errorHandler
    
    'Break the filename into Filename and Extension.
    ParseFileNameAndExtension sSHPFilename, sFilename, sSHPExtension
    
    'Get the filename with the .SHX extension.
    sSHXFilename = sFilename & ".SHX"
    
    'Make sure the .SHX file exists.  If not, then display a warning message.
    If Len(Dir(sSHXFilename)) <> 0 Then
    
        'Open the .SHP file.
        m_lSHPFileHandle = FreeFile
        Open sSHPFilename For Binary Access Read As m_lSHPFileHandle
        
        'Open the .SHX file.
        m_lSHXFileHandle = FreeFile
        Open sSHXFilename For Binary Access Read As m_lSHXFileHandle
        
        'Get the .SHX file header.
        Get m_lSHXFileHandle, , m_uSHXFileHeader
        With m_uSHXFileHeader
            .FileCode = SwapEndians(.FileCode)
            
            'Make sure this file has the "Shape File Code" in the header -- otherwise
            'this isn't a real .SHX file.
            If .FileCode <> SHAPE_FILE_CODE Then
                Close m_lSHXFileHandle
                OpenShapeFile = False
                GoTo routineExit
            End If
            
            .FileLength = SwapEndians(.FileLength)
            .Unused1 = SwapEndians(.Unused1)
            .Unused2 = SwapEndians(.Unused2)
            .Unused3 = SwapEndians(.Unused3)
            .Unused4 = SwapEndians(.Unused4)
            .Unused5 = SwapEndians(.Unused5)
        End With
        
        'Calculate the number of records in this file.
        m_lRecordCount = (m_uSHXFileHeader.FileLength - 50) / 4
        
        'Get the .SHP file header.
        Get m_lSHPFileHandle, , m_uSHPFileHeader
        With m_uSHPFileHeader
            .FileCode = SwapEndians(.FileCode)
            
            'Make sure this file has the "Shape File Code" in the header -- otherwise
            'this isn't a real .SHP file.
            If .FileCode <> SHAPE_FILE_CODE Then
                Close m_lSHXFileHandle
                Close m_lSHPFileHandle
                OpenShapeFile = False
                GoTo routineExit
            End If
            
            .FileLength = SwapEndians(.FileLength)
            .Unused1 = SwapEndians(.Unused1)
            .Unused2 = SwapEndians(.Unused2)
            .Unused3 = SwapEndians(.Unused3)
            .Unused4 = SwapEndians(.Unused4)
            .Unused5 = SwapEndians(.Unused5)
        End With
        
        'Get the Shape Type.
        m_eShapeType = m_uSHPFileHeader.ShapeType
        OpenShapeFile = True
        
    Else
        'The .SHX file wasn't found -- we can't do anything without it, so
        'warn the user and return False.
        MsgBox "The following file was not found:" & vbCrLf & vbCrLf _
             & sSHXFilename & vbCrLf & vbCrLf _
             & "This file is required in order to continue."
             
        OpenShapeFile = False
    End If
    
routineExit:
    Exit Function
errorHandler:
    MsgBox "Error in GenerateShapes" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Function

Private Function GeneratePoints() As SpatialDataImport.DataPoints
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Generates a collection of DataPoint objects that represent the data
    '           within an ESRI .SHP file.
    ' Assumptions:
    ' Notes:
'**********************************************************************************

    Dim lRecordIndex As Long
    Dim oDataPoints As SpatialDataImport.DataPoints
    Dim oDataPoint As SpatialDataImport.DataPoint
    Dim bSuccess As Boolean
    Dim eShapeType As ESRI_SHAPETYPE
    Dim lNumberOfPoints As Long
    Dim lPointIndex As Long
    Dim uBoundingBox As Type_BoundingBox
    Dim fXValue As Double
    Dim fYValue As Double
    
    On Error GoTo errorHandler
    
    'Make sure there are records.
    If m_lRecordCount <> 0 Then
        
        'Initialize the DataPoints collection.
        Set oDataPoints = New SpatialDataImport.DataPoints
        
        'Loop through all the records.
        For lRecordIndex = 1 To m_lRecordCount
        
            'Try to get the SHX record header.
            bSuccess = GetSHXRecordHeader(lRecordIndex)
            If bSuccess = True Then
            
                'Try to get the SHP record header.
                bSuccess = GetSHPRecordHeader(m_uSHXRecordHeader.Offset * 2 + 1)
                If bSuccess = True Then
                
                    'Make sure the record number we got from the SHP file is the
                    'same record number that we are getting from the SHX file.
                    If m_uSHPRecordHeader.RecordNumber = lRecordIndex Then
                    
                        'Create a new DataPoint object.
                        Set oDataPoint = New SpatialDataImport.DataPoint
                        
                        'Get the Shape Type.
                        Get m_lSHPFileHandle, , eShapeType
                        
                        'Make sure that this shape type matches the one we got
                        'in the header (Shapefiles must contain shapes of all the
                        'same type).
                        If eShapeType = m_eShapeType Then
                        
                            'We're using this routine to handle two different (but
                            'closely related) shape types, so we need to take a
                            'slightly different course of action depending on which one
                            'we're dealing with.
                            Select Case eShapeType
                                Case SHAPETYPE_POINT
                                    'A "Point" shape type contains just one point for
                                    'each record.
                                    
                                    'Get the Longitude (x) and Latitude (y) values.
                                    Get m_lSHPFileHandle, , fXValue
                                    Get m_lSHPFileHandle, , fYValue
                                    
                                    'Create a new DataPoint and set its properties.
                                    Set oDataPoint = New SpatialDataImport.DataPoint
                                    oDataPoint.Longitude = fXValue
                                    oDataPoint.Latitude = fYValue
                                    
                                    'Add the new DataPoint to the collection.
                                    oDataPoints.Add oDataPoint
                                    
                                Case SHAPETYPE_MULTIPOINT
                                    'A "MultiPoint" shape type contains multiple points
                                    'for each record.
                                    
                                    'Get the Bounding Box (we don't retain this info
                                    'right now, since we don't represent it visually).
                                    Get m_lSHPFileHandle, , uBoundingBox
                                    
                                    'Get the number of points in this record.
                                    Get m_lSHPFileHandle, , lNumberOfPoints
                                    
                                    'Make sure there is at least 1 point.
                                    If lNumberOfPoints > 0 Then
                                    
                                        'Loop through all the points.
                                        For lPointIndex = 0 To lNumberOfPoints - 1
                                            
                                            'Get the Longitude (x) and Latitude (y) values.
                                            Get m_lSHPFileHandle, , fXValue
                                            Get m_lSHPFileHandle, , fYValue
                                            
                                            'Create a new DataPoint and set its properties.
                                            Set oDataPoint = New SpatialDataImport.DataPoint
                                            oDataPoint.Longitude = fXValue
                                            oDataPoint.Latitude = fYValue
                                            
                                            'Add the new DataPoint to the collection.
                                            oDataPoints.Add oDataPoint
                                            
                                        Next lPointIndex
                                    End If
                                    
                            End Select
                        End If
                    End If
                End If
            End If
        Next lRecordIndex
    End If
    
    'Return the collection object.
    Set GeneratePoints = oDataPoints
    
    Exit Function
errorHandler:
    MsgBox "Error in GeneratePoints" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Function

Private Function GenerateLines() As SpatialDataImport.Lines
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Generates a collection of Line objects that represent the data
    '           within an ESRI .SHP file.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    Dim lRecordIndex As Long
    Dim oLine As SpatialDataImport.Line
    Dim oLines As SpatialDataImport.Lines
    Dim oDataPoint As SpatialDataImport.DataPoint
    Dim bSuccess As Boolean
    Dim eShapeType As ESRI_SHAPETYPE
    Dim lNumberOfParts As Long
    Dim lNumberOfPoints As Long
    Dim lPartIndex As Long
    Dim lPointIndex As Long
    Dim uBoundingBox As Type_BoundingBox
    Dim alParts() As Long
    Dim fXValue As Double
    Dim fYValue As Double
    
    On Error GoTo errorHandler
    
    'Make sure there are records.
    If m_lRecordCount <> 0 Then
        
        'Initialize the Lines collection.
        Set oLines = New SpatialDataImport.Lines
        
        'Loop through all the records.
        For lRecordIndex = 1 To m_lRecordCount
        
            'Try to get the SHX record header.
            bSuccess = GetSHXRecordHeader(lRecordIndex)
            If bSuccess = True Then
            
                'Try to get the SHP record header.
                bSuccess = GetSHPRecordHeader(m_uSHXRecordHeader.Offset * 2 + 1)
                If bSuccess = True Then
                
                    'Make sure the record number we got from the SHP file is the
                    'same record number that we are getting from the SHX file.
                    If m_uSHPRecordHeader.RecordNumber = lRecordIndex Then
                    
                        'Create a new Line object.
                        Set oLine = New SpatialDataImport.Line
                        
                        'Get the Shape Type.
                        Get m_lSHPFileHandle, , eShapeType
                        
                        'Make sure that this shape type matches the one we got
                        'in the header (Shapefiles must contain shapes of all the
                        'same type).
                        If eShapeType = m_eShapeType Then
                            
                            'Get the Bounding Box (we don't retain this info
                            'right now, since we don't represent it visually).
                            Get m_lSHPFileHandle, , uBoundingBox
                            
                            'Get the number of Parts (a Line can contain several Parts,
                            'which can contain several Points).
                            Get m_lSHPFileHandle, , lNumberOfParts
                            
                            'Get the number of Points.
                            Get m_lSHPFileHandle, , lNumberOfPoints
                            
                            'Make sure there are Parts.
                            If lNumberOfParts > 0 Then
                            
                                'Get the Parts.
                                ReDim alParts(0 To lNumberOfParts - 1) As Long
                                Get m_lSHPFileHandle, , alParts
                            
                                'Loop through all the Parts.
                                For lPartIndex = 0 To lNumberOfParts - 1
                                    If lPartIndex = lNumberOfParts - 1 Then
                                        
                                        'Loop through all the Points that make up this Part.
                                        For lPointIndex = alParts(lPartIndex) To lNumberOfPoints - 1
                                            
                                            'Get the Longitude (x) and Latitude (y) values.
                                            Get m_lSHPFileHandle, , fXValue
                                            Get m_lSHPFileHandle, , fYValue
                                            
                                            'Create a new DataPoint and set its properties.
                                            Set oDataPoint = New SpatialDataImport.DataPoint
                                            oDataPoint.Longitude = fXValue
                                            oDataPoint.Latitude = fYValue
                                            
                                            'Add the new DataPoint to the collection.
                                            oLine.DataPoints.Add oDataPoint
                                            
                                        Next lPointIndex
                                        
                                    Else
                                        
                                        'Loop through all the Points that make up this Part.
                                        For lPointIndex = alParts(lPartIndex) To alParts(lPartIndex + 1) - 1
                                            
                                            'Get the Longitude (x) and Latitude (y) values.
                                            Get m_lSHPFileHandle, , fXValue
                                            Get m_lSHPFileHandle, , fYValue
                                            
                                            'Create a new DataPoint and set its properties.
                                            Set oDataPoint = New SpatialDataImport.DataPoint
                                            oDataPoint.Longitude = fXValue
                                            oDataPoint.Latitude = fYValue
                                            
                                            'Add the new DataPoint to the collection.
                                            oLine.DataPoints.Add oDataPoint
                                            
                                        Next lPointIndex
                                    End If
                                Next lPartIndex
                                
                                'Add this Line to the collection.
                                oLines.Add oLine
                                    
                            End If
                        End If
                    End If
                End If
            End If
        Next lRecordIndex
    End If
    
    'Return the collection object.
    Set GenerateLines = oLines
    
    Exit Function
errorHandler:
    MsgBox "Error in GenerateLines" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Function

Private Function GenerateRegions() As SpatialDataImport.Regions
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Generates a collection of Region objects that represent the data
    '           within an ESRI .SHP file.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    Dim lRecordIndex As Long
    Dim oRegion As SpatialDataImport.Region
    Dim oRegions As SpatialDataImport.Regions
    Dim oDataPoint As SpatialDataImport.DataPoint
    Dim bSuccess As Boolean
    Dim eShapeType As ESRI_SHAPETYPE
    Dim lNumberOfParts As Long
    Dim lNumberOfPoints As Long
    Dim lPartIndex As Long
    Dim lPointIndex As Long
    Dim uBoundingBox As Type_BoundingBox
    Dim alParts() As Long
    Dim fXValue As Double
    Dim fYValue As Double
    
    On Error GoTo errorHandler
    
    'Make sure there are records.
    If m_lRecordCount <> 0 Then
        
        'Initialize the Lines collection.
        Set oRegions = New SpatialDataImport.Regions
        
        'Loop through all the records.
        For lRecordIndex = 1 To m_lRecordCount
        
            'Try to get the SHX record header.
            bSuccess = GetSHXRecordHeader(lRecordIndex)
            If bSuccess = True Then
            
                'Try to get the SHP record header.
                bSuccess = GetSHPRecordHeader(m_uSHXRecordHeader.Offset * 2 + 1)
                If bSuccess = True Then
                
                    'Make sure the record number we got from the SHP file is the
                    'same record number that we are getting from the SHX file.
                    If m_uSHPRecordHeader.RecordNumber = lRecordIndex Then
                    
                        'Create a new Region object.
                        Set oRegion = New SpatialDataImport.Region
                        
                        'Get the Shape Type.
                        Get m_lSHPFileHandle, , eShapeType
                        
                        'Make sure that this shape type matches the one we got
                        'in the header (Shapefiles must contain shapes of all the
                        'same type).
                        If eShapeType = m_eShapeType Then
                            
                            'Get the Bounding Box (we don't retain this info
                            'right now, since we don't represent it visually).
                            Get m_lSHPFileHandle, , uBoundingBox
                            
                            'Get the number of Parts (a Region can contain several Parts,
                            'which can contain several Points).
                            Get m_lSHPFileHandle, , lNumberOfParts
                            
                            'Get the number of Points.
                            Get m_lSHPFileHandle, , lNumberOfPoints
                            
                            'Make sure there are Parts.
                            If lNumberOfParts > 0 Then
                            
                                'Get the Parts.
                                ReDim alParts(0 To lNumberOfParts - 1) As Long
                                Get m_lSHPFileHandle, , alParts
                            
                                'Loop through all the Parts.
                                For lPartIndex = 0 To lNumberOfParts - 1
                                    If lPartIndex = lNumberOfParts - 1 Then
                                        
                                        'Loop through all the Points that make up this Part.
                                        For lPointIndex = alParts(lPartIndex) To lNumberOfPoints - 1
                                            
                                            'Get the Longitude (x) and Latitude (y) values.
                                            Get m_lSHPFileHandle, , fXValue
                                            Get m_lSHPFileHandle, , fYValue
                                            
                                            'Create a new DataPoint and set its properties.
                                            Set oDataPoint = New SpatialDataImport.DataPoint
                                            oDataPoint.Longitude = fXValue
                                            oDataPoint.Latitude = fYValue
                                            
                                            'Add the new DataPoint to the collection.
                                            oRegion.DataPoints.Add oDataPoint
                                            
                                        Next lPointIndex
                                        
                                    Else
                                    
                                        'Loop through all the Points that make up this Part.
                                        For lPointIndex = alParts(lPartIndex) To alParts(lPartIndex + 1) - 1
        
                                            'Get the Longitude (x) and Latitude (y) values.
                                            Get m_lSHPFileHandle, , fXValue
                                            Get m_lSHPFileHandle, , fYValue
                                            
                                            'Create a new DataPoint and set its properties.
                                            Set oDataPoint = New SpatialDataImport.DataPoint
                                            oDataPoint.Longitude = fXValue
                                            oDataPoint.Latitude = fYValue
                                            
                                            'Add the new DataPoint to the collection.
                                            oRegion.DataPoints.Add oDataPoint
                                            
                                        Next lPointIndex
                                    End If
                                Next lPartIndex
                                    
                                'Add this Line to the collection.
                                oRegions.Add oRegion
                                    
                            End If
                        End If
                    End If
                End If
            End If
        Next lRecordIndex
    End If
    
    'Return the collection object.
    Set GenerateRegions = oRegions
    
    Exit Function
errorHandler:
    MsgBox "Error in GenerateRegions" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Function

Private Function GetSHXRecordHeader(lRecordIndex As Long) As Boolean
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Gets the record header for a given record number from the SHX file.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    Dim lByteOffset As Long
    
    On Error GoTo problemReadingRecordHeader
    
    If lRecordIndex = 1 Then
        lByteOffset = MAIN_HEADER_SIZE + 1
    Else
        lByteOffset = MAIN_HEADER_SIZE + ((lRecordIndex - 1) * 8) + 1
    End If
    If lByteOffset > m_uSHXFileHeader.FileLength * 2 - (INDEX_REC_SIZE - 1) Then
        GetSHXRecordHeader = False      'offset is greater then the length of the main file
    Else
        Get m_lSHXFileHandle, lByteOffset, m_uSHXRecordHeader
        With m_uSHXRecordHeader
            .ContentLength = SwapEndians(.ContentLength)
            .Offset = SwapEndians(.Offset)
        End With
        GetSHXRecordHeader = True
    End If
    
    Exit Function
problemReadingRecordHeader:
    GetSHXRecordHeader = False
End Function

Private Function GetSHPRecordHeader(lOffset As Long) As Boolean
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Gets the record header for a given record from the SHP file.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    On Error GoTo problemReadingRecordHeader
    
    Get m_lSHPFileHandle, lOffset, m_uSHPRecordHeader
    With m_uSHPRecordHeader
        .ContentLength = SwapEndians(.ContentLength)
        .RecordNumber = SwapEndians(.RecordNumber)
    End With

    GetSHPRecordHeader = True
    
    Exit Function
problemReadingRecordHeader:
    GetSHPRecordHeader = False
End Function

Private Function SwapEndians(lOriginalNumber As Long) As Long
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Converts a number given in "big endian" format into "little endian"
    '           format, and vice-versa.  This is necessary because some of the
    '           data fields in a Shapefile are in "big endian" format, which is
    '           not supported on Intel machines.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
  Dim uTempLong As Type_LongType
  Dim uOrigBytes As Type_FourByteType
  Dim uNewBytes As Type_FourByteType
  
  On Error GoTo errorHandler
  
  uTempLong.l = lOriginalNumber
  LSet uOrigBytes = uTempLong
  uNewBytes.b1 = uOrigBytes.b4
  uNewBytes.b2 = uOrigBytes.b3
  uNewBytes.b3 = uOrigBytes.b2
  uNewBytes.b4 = uOrigBytes.b1
  LSet uTempLong = uNewBytes
  SwapEndians = uTempLong.l
    
    Exit Function
errorHandler:
    MsgBox "Error in SwapEndians" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Function

